perm filename PLOUX.F4[PIC,LCS]1 blob sn#083134 filedate 1974-01-15 generic text, type T, neo UTF8
00100		SUBROUTINE PLOU
00200		COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,ROT,RLR,RUD,CONST,E
00300		1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR,A,IA,IB,IC,ID
00400	C  KA-D IS FOR INVIS. INNER AREA.  IA-D IS FOR INVIS. OUTER AREA.
00500	
00600		DIMENSION IDP1(4000),INP(10,20)
00700	  
00800		COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
00900		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01000		1 LSIDE,RSIDE,DTA,HYSTAB(1)
01100		INTEGER FLINE,RSIDE
01200		DATA NEWX/0/,NCNT/0/
01300		IF(NEWEND)GO TO 6002
01400		IF(NEWX)GO TO 1
01500		RTO=6
01600	CC	LSIDE=6
01700	CC	RSIDE=265
01800	CC	FLINE=20
01900	CC	LLINE=250
02000		NX=0
02100		NY=0
02200	
02300	1001	FORMAT(A1,3F)
02400	1000	FORMAT(' D, P, S, M OR T    HORZ.%,VRT.%,   ROTATION'/)
02500	6100	FORMAT(' INNER CLEAR AREA L-R-BT-TP%  OUTER L-R-B-T%
02600		1   REV=1, INV=1'/)
02700	6001	FORMAT(10F)
02800	1	CALL JZERO
02900		JX=0
03000		JY=0
03100		CONST=0
03200		TYPE 1000
03300		ACCEPT 1001,WHICH,RLR,RUD,ROT
03400		IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
03500		REREAD 3,(INP(NA,NCNT),NA=1,10)
03800		IF(WHICH.NE.'H')GO TO 8002
03900		TYPE 9002
04000		GO TO 1
04100	9002	FORMAT(' D=DISPLAY, P=PLOT, S=SAVE FOR DRAWING PROG.'/
04200		1 ' M=MOVE, T=TYPE MY INPUT BACK.'/)
04300	8002	IF(WHICH.NE.'T')GO TO 3002
04400	6002	DO 4002 K=1,NCNT
04500	4002	TYPE 5002,(INP(NA,K),NA=1,10)
04600		IF(NEWEND)RETURN
04700		GO TO 1000
04705	3002	IF(WHICH.EQ.'M')GO TO 3102
04710		TYPE 6100
04720		ACCEPT 6001,A,B,C,D,E,F,G,H,REV,RINV
04800		IF(NCNT.LT.20.AND.WHICH.NE.WX)NCNT=NCNT+1
04900		REREAD 3,(INP(NA,NCNT),NA=1,10)
05000	3102	JPL=3
05100		WX=WHICH
05200	C  SO IT WON'T COUNT RETRIES.
05300	3	FORMAT(10A5)
05400	5002	FORMAT(1X10A5)
05500	C  FAC=SIZE BY 100'S, RLR=LEFT-RIGHT SIZE, RUD=UP-DOWN SIZE
05600	C-- D 0 0    0,50,0,50 CLEARS LOWER LFT QUAD. 50 100 50 100 UPR RT.
05700	C  TYPE 'T' TO GET BACK ALL INPUT LINES.
05800		IF(A+B+C+D.EQ.0)A=-1.
05900	C 'N'= PLOT, BUT NO X
06000		IF(WHICH.NE.'S')GO TO 7002
06100		WHICH='P'
06200		CONST=-1
06300	7002	IF(WHICH.EQ.'M')GO TO 2002
06400		IF(E+D+F+G.EQ.0)E=-1.
06500		IF(RLR.EQ.0)RLR=100.
06600		IF(RUD.EQ.0)RUD=100.
06700		IF(ROT.EQ.1)RINV=RINV-1
06800	2002	RLR=RLR/100.
06900		RUD=RUD/100.
07000		PLT=0
07100		IF(WHICH.NE.'D')GO TO 1002
07200	C  DPY IS 1/3 SIZE OF PLOT.
07300		GO TO 2000
07400	
07500	1102	IF(WHICH.NE.'M')GO TO 1
07600	C  MOVE PEN, L-R%, U-D
07700	2200	RX=JMC
07800		RY=JMD
07900		NX=RX*RLR
08000		NY=RY*RUD
08100		RLR=.01
08200		RUD=.01
08300		GO TO 67
08400	
08500	1002  IF(WHICH.NE.'P')GO TO 1102
08600		PLT=1
08700	
08800	2000	IF(NEWEND.GT.1000) PAUSE 'NEWEND>1000'
08900	67	MA=0
09000		MB=0
09100		MC=(RSIDE-LSIDE)*RTO*RLR+.5
09200		MD=(LLINE-FLINE)*RTO*RUD+.5
09300		JM=-380
09400		KM=-200
09500		IF(NEWX)GO TO 655
09600		JMC=MC
09700		JMD=MD
09800	655	JQX=NX
09900		JQY=NY
10000		IF(WHICH.EQ.'M')GO TO 671
10100		TYPE 657
10200	657	FORMAT(' OUTER LIMITS')
10300		TYPE 65,MA,MC,MB,MD
10400	C   OUTER COORDINATES
10500	CC	JREV=(JA+JC)/JPL
10600	C	JINV=(JB+JD)/JPL
10700		KA=0
10800		KB=0
10900		KC=0
11000		KD=0
11100		IA=-1
11200		IB=99999
11300		IC=-1
11400		ID=99999
12100	671	IF(NEWX.NE.-1)CALL DPYSET(1,IDP1,4000)
12200		CALL SETPOG(1)
12300		CALL TYPLOC(-300,-611)
12400		CALL DPYBRT(6)
12500		JX=NX/JPL
12600		JY=NY/JPL
12700		CALL AIVECT(-380,-200)
12800	672	JA=0
12900		JB=0
13000		NC=MC/JPL
13100		ND=MD/JPL
13200		CALL LINES(3)
13300	CC	CALL JZERO
13400		JA=NC
13500		JB=0
13600		CALL LINES(2)
13700		JA=NC
13800		JB=ND
13900		CALL LINES(2)
14000		JB=ND
14100		JA=0
14200		CALL LINES(2)
14300		JA=0
14400		JB=0
14500		CALL LINES(2)
14600		CALL DPYOUT(1)
14700		IF(WHICH.NE.'M')GO TO 2683
14800	168	NY=JQY
14900		NX=JQX
15000		GO TO 1
15100	2683	NQ=0
15200		IF(A)GO TO 1683
15300		KA=MC*(A/100.)
15400		KB=MC*(B/100.)
15500		KC=MD*(C/100.)
15600		KD=MD*(D/100.)
15800		CALL INVIS(KA,KB,KC,KD,NQ)
16000	1683	IF(E)GO TO 8683
16100		IA=MC*(E/100.)
16200		IB=MC*(F/100.)
16300		IC=MD*(G/100.)
16400		ID=MD*(H/100.)
16600		CALL INVIS(IA,IB,IC,ID,NQ)
16700		IF(PLT.EQ.0)E=-1
16800	8683	IF(PLT.NE.0)JPL=1
16900		KA=KA/JPL
17000		KB=KB/JPL
17100		KC=KC/JPL
17200		KD=KD/JPL
17210		IA=IA/JPL
17232		IB=IB/JPL
17254		IC=IC/JPL
17276		ID=ID/JPL
17300		TYPE 683
17400	683	FORMAT(' OK?'/)
17500		ACCEPT 1001,NA
17600		IF(NA.EQ.'N')GO TO 168
17700		JX=NX/JPL
17800		JY=NY/JPL
17900		IF(PLT.NE.0)GO TO 1681
18000	6852	CALL CLRPOG(2)
18100		CALL SETPOG(1)
18200	CC	JA=-380
18300	CC	JB=-200
18400		CALL JZERO
18500		CALL AIVECT(-380,-200)
18600		GO TO 685
18700	50	FORMAT(' DO YOU WANT THE FRAME ?'/)
18800	1681	TYPE 50
18900	65	FORMAT(' LFT=',I4,'   RT=',I4,'   BOT=',I4,'   TOP=',I4)
19000		ACCEPT 1001,ALFAB
19100	CC2	IF(WHICH.EQ.'N')GO TO 681
19200		IF(NEWX.NE.-1)CALL PLOTS(I)
19900	681	PLT=-1
20000		IF(ALFAB.EQ.'N') GOTO 685
20100		JX=NX
20200		JY=NY
20300		JA=0
20400		JB=0
20500		CALL LINES(3)
20600		JA=MC
20700		JB=0
20800		CALL LINES(2)
20900		JA=MC
21000		JB=MD
21100		CALL LINES(2)
21200		JA=0
21300		JB=MD
21400		CALL LINES(2)
21500		JA=0
21600		JB=0
21700		CALL LINES(2)
21800	685	JAR=0
21900		JBR=0
22200		JREV=MC/JPL
22300		JINV=MD/JPL
22400		IF(CONST)PLT=-2
22500		CALL PLTMAN
22600		NEWX=-1
22700		NX=JQX
22800		NY=JQY
22900		WX=0
23000		IF(PLT)CALL PLOT(0,0,3)
23100		END